home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1995 November / Macworld Nov ’95.toast / Developers / Selection ƒ 2.5 / editlist < prev    next >
Encoding:
Text File  |  1994-11-06  |  12.9 KB  |  507 lines  |  [TEXT/MSET]
  1.  \ 29Aug94 DBH moved ListData init: to classinit:.
  2.      \ It was being executed after new:  !
  3.  \ 28Oct94 dbh updated to 2.5 syntax 
  4.  
  5.  
  6. (*
  7.  
  8. An editlist is a scrollable/editable row and column matrix of text data.  While
  9. resembling the ListManager note that we do *not* use any ListManager routines
  10. at all.  Of course we follow our selection protocol so use is very simple and
  11. we can have multiple editlists in a window.  The unique feature of an editlist
  12. is that the TextEdit field will appear *in* the current cell being edited.
  13.  
  14. Note that classinit: contains all of the setup parameters (number of rows
  15. and columns and so forth).  Default is 30 rows and 30 columns, but we
  16. don't display all at once.  We can scroll through them.  A subclass could
  17. easily have different values.
  18.  
  19. Note also that we provide for a filterprocedure: method that could be
  20. over ridden to inspect data from a cell after it is entered, or any time
  21. we attempt to leave that cell.  Here the filterprocedure: method simply
  22. returns true.  Returning false would result in the user being returned to
  23. the offending cell until acceptable data was entered.
  24.  
  25. *)
  26.  
  27.  
  28. :class editlist super{ nullselect }
  29.     
  30.     var #ofRows            \ number of virtual rows of data
  31.     var #ofColumns
  32.     var CurrentRow
  33.     var CurrentColumn
  34.     int #ofDisplayRows
  35.     int #ofDisplayColumns
  36.     int Characters/Cell
  37.     rect+ dataRect        \ the scrollable data rectangle
  38.     rect+ hitRect        \ will enclose scrollbars as well
  39.     rect+ DisplayRectangle
  40.     rect+ VscrollRectangle    \ the rectangle to scroll, not the control size
  41.     rect+ HscrollRectangle    \ the rectangle to scroll, not the control size
  42.     int CellHeight
  43.     int CellWidth
  44.     te EditField
  45.     vscrollBar VScrollControl
  46.     hscrollBar HScrollControl
  47.     2arrayGen ListData
  48.     int x
  49.     int y
  50.  
  51.  
  52. :m classinit:
  53.     48 put: x
  54.     50 put: y
  55.     30 put: #ofRows 
  56.     30 put: #ofColumns
  57.     5  put: #ofDisplayRows 
  58.     4  put: #ofDisplayColumns
  59.     6  put: Characters/Cell
  60.  
  61.     get: #ofRows  get: #ofColumns  get: Characters/Cell init: ListData
  62.     
  63. \    " Helvetica" putfontname: editfield     \ 28Dec93 dbh this will work
  64. \    15 putfontsize: editfield
  65.      
  66.     ;m
  67.  
  68.  
  69. :m DrawHorizontalLines: { \ y -- }
  70.     get: #ofDisplayRows 1 ?DO
  71.         getTopx: dataRect 1+ ( x)
  72.         gettopy: dataRect  I get: CellHeight * + ( y) dup -> y MoveTo
  73.         getbotx: dataRect 1 -  ( x)  y ( y)
  74.         LineTo  LOOP ;m
  75.  
  76. :m DrawVerticalLines: { \ x -- }
  77.     get: #ofDisplayColumns 1 ?DO
  78.         getTopx: dataRect I get: CellWidth * +  ( x) dup -> x
  79.         gettopy: dataRect ( y)  MoveTo
  80.         x ( x)  getboty: dataRect 1- ( y)  LineTo  LOOP ;m
  81.  
  82. :m DrawGrid:
  83.     call PenNormal
  84.     draw: DisplayRectangle
  85.     3 ( gray ) SYSPAT get: ** call PenPat
  86.     DrawHorizontalLines: self
  87.     DrawVerticalLines: self ;m
  88.  
  89. :m init:    \ must only call after new:
  90.     lineheight: editField  1 + put:  CellHeight
  91.     widmax: editField  get: Characters/Cell * 4 + put: CellWidth
  92.     
  93.     get: x ( x1) get: y  ( y1)
  94.     get: #ofDisplayColumns get: CellWidth * get: x + ( x2)
  95.     get: #ofDisplayRows  get: CellHeight * get: y + ( y2) put: dataRect
  96.     
  97.     get: dataRect  ( x1 y1 x2 y2) 1+ swap 1+ swap put: DisplayRectangle
  98.     
  99.     gettopx: dataRect  get: CellWidth - ( x1)  gettopy: dataRect 1 +  ( y1)
  100.     getbotx: dataRect  ( x2)   getboty: dataRect ( y2)
  101.         put: VscrollRectangle
  102.         
  103.     gettopx: dataRect 1 + ( x1)  gettopy: dataRect get: CellHeight - 5 - ( y1)
  104.     getbotx: dataRect  ( x2)   getboty: dataRect ( y2)
  105.         put: HscrollRectangle
  106.     
  107.     get: dataRect put: hitRect    5 16 + ( dx)  dup ( dy) stretch: hitRect
  108.     ;m
  109.  
  110. :m movepen:  { row# col# -- } \ position QuickDraw pen for cell text display
  111.     gettopx: dataRect col#   get: CellWidth * + 2 +  ( x)
  112.     gettopy: dataRect row#  get: CellHeight * +  ascent: editField + 1+ ( y)     \ 28Dec93 XXX
  113.     MoveTo ;m
  114.  
  115. :m DrawCellData:  { row# col# -- }
  116.     row# get: VScrollControl +  ( row#indice )
  117.     col# get: HScrollControl +  ( col#indice )
  118.     at: ListData  mDrawString ;m
  119.  
  120. :m DrawRowData:  { row# -- }
  121.     get: #ofDisplayColumns 0
  122.     ?DO
  123.         row# I movepen: self
  124.         row# I DrawCellData: self
  125.     LOOP ;m
  126.  
  127. :m DrawData:
  128.     get: #ofDisplayRows 0 ?DO  I DrawRowData: self LOOP ;m
  129.  
  130.  
  131. \ *** optional row and column labeling routines
  132.  
  133. :m DrawColNumber: { col# -- }
  134.     gettopx: dataRect 2 +  col# get: CellWidth * + ( x)
  135.     gettopy: dataRect  ascent: editField - ( y)     \ 28Dec93 XXX
  136.     MoveTo
  137.     col# get: HScrollControl + number>$ mDrawString ;m
  138.  
  139. :m DrawRowNumber: { row# -- }
  140.     gettopx: dataRect 14 -  ( x)
  141.     gettopy: dataRect  get: CellHeight +  row# get: CellHeight * + ( y)
  142.     MoveTo
  143.     row# get: VScrollControl + number>$ mDrawString ;m
  144.  
  145. :m DrawLabels:
  146.     get: #ofDisplayRows 0
  147.     ?DO
  148.         I DrawRowNumber: self
  149.     LOOP
  150.     get: #ofDisplayColumns 0
  151.     ?DO
  152.         I DrawColNumber: self
  153.     LOOP
  154.     ;m
  155.  
  156. :m new:    { wptr -- }
  157.     wptr new: EditField
  158.     lineHeight: EditField 1+ setlineHeight: EditField     \ 28Dec93 dbh
  159.  
  160.     init: self
  161.  
  162.     new: ListData
  163.     
  164.     noWrap: EditField
  165.     
  166.     gettopx: dataRect ( x)  getboty: dataRect 5 + ( y)
  167.     size: DisplayRectangle drop ( width) init: HScrollControl
  168.     wptr  new: HScrollControl
  169.         self ( OwnerObj) scrolledBy: HScrollControl    \ this must come after new:
  170.     0 ( lo) get: #ofColumns  get: #ofDisplayColumns - ( hi)  putrange: HScrollControl
  171.  
  172.     getbotx: dataRect 5 + ( x)  gettopy: dataRect ( y)
  173.     size: DisplayRectangle swap drop ( height) init: VScrollControl
  174.     wptr  new: VScrollControl
  175.         self ( OwnerObj) scrolledBy: VScrollControl    \ this must come after new:
  176.     0 ( lo) get: #ofRows  get: #ofDisplayRows - ( hi)  putrange: VScrollControl
  177.  
  178.     get: VScrollRectangle setScrollRect: VScrollControl
  179.     get: HScrollRectangle setScrollRect: HScrollControl
  180.     
  181.     get: cellHeight  get: #ofDisplayRows setScrollValues: VScrollControl
  182.     get: cellWidth  get: #ofDisplayColumns setScrollValues: HScrollControl
  183.     
  184.     get: #ofcolumns 1 <= IF hide: HScrollControl 0 -21 stretch: hitrect THEN
  185.     get: #ofRows 1 <= IF hide: VScrollControl -21 0 stretch: hitrect THEN
  186.  
  187.     ;m
  188.  
  189.  
  190. :m to:  ( addr len row# col# -- )
  191.     to: listData ;m
  192.  
  193.  
  194. \ need some standard protocol select methods:
  195.  
  196. :m hit?:  ( -- b )
  197.     where: theMouse
  198.     hitRect PtinRect ;m
  199.  
  200. :m focus?: ( -- t ) true ;m
  201.  
  202. :m alwaysActive?: ( -- f ) false ;m
  203.  
  204. :m draw:
  205.     set: EditField    \ assures that we use all of the proper font characteristics
  206.     DrawData: self    \ should draw cells before editfield
  207.     visible?: [self]
  208.     IF
  209.         moveTErects: [self] \ need this because we might not have this set properly
  210.                             \ when the scrollbars send draw: messages during continuous
  211.                             \ scrolling.  This was a little tricky to track down!
  212.         draw: EditField
  213.     THEN
  214.     DrawGrid: self
  215.     DrawLabels: self
  216.     draw: VScrollControl
  217.     draw: HScrollControl
  218.     ;m
  219.  
  220. :m release:
  221.     release: ListData
  222.     release: EditField
  223.     release: VScrollControl
  224.     release: HScrollControl ;m
  225.  
  226.  
  227.  
  228. \ ******* the following handles cell selection and hilighting
  229.  
  230. :m Visible?:  ( -- b ) \ true if the current cell is visible
  231.     get: CurrentRow ( n)  get: VScrollControl ( lo)
  232.         dup get: #ofDisplayRows + 1 - ( hi) within?
  233.         nip        \ nip n left over from within?
  234.     get: CurrentColumn ( n)  get: HScrollControl ( lo)
  235.         dup get: #ofDisplayColumns + 1 - ( hi) within?
  236.         nip        \ nip n left over from within?
  237.     and
  238.     ;m          \ cell is visible only if within both given ranges
  239.  
  240.  
  241. \ ******* CellLeft:, CellTop:, CellRight:, and CellBottom: return the edges of
  242. \            the current cell
  243.  
  244. :m CellLeft: ( -- n )
  245.     get: CurrentColumn  get: HScrollControl -  get: CellWidth *
  246.     gettopx: dataRect + ;m
  247.  
  248. :m CellTop: ( -- n )
  249.     get: CurrentRow  get: VScrollControl -  get: CellHeight *
  250.     gettopy: dataRect + ;m
  251.  
  252. :m CellRight: ( -- n )
  253.     CellLeft: self  get: CellWidth + ;m
  254.  
  255. :m CellBottom: ( -- n )
  256.     CellTop: self  get: CellHeight + ;m
  257.  
  258. :m TeText->ListData:  \ store the text edit characters in the data array
  259.     get: EditField ( addr len )
  260.     get: Characters/Cell  min          \ assure len is not too large!
  261.     get: CurrentRow  get: CurrentColumn  to: ListData ;m
  262.  
  263. :m TeText->Cell:    \ display the text edit characters in the current cell
  264.     CellLeft: self 2 + ( x)  CellBottom: self  descent: EditField - 1 - ( y) MoveTo  \ 28Dec93 XXX
  265.     get: EditField ( addr len )
  266.     get: Characters/Cell  min          \ assure len is not too large!
  267.     set: EditField     \ 28Dec93 XXX
  268.     mDrawString ;m
  269.  
  270. :m ListData->TeText:    \ place the data for the current cell into the textedit
  271.             \ field and then select the characters in the field
  272.     get: CurrentRow  get: CurrentColumn  at: ListData  ( addr len)
  273.     put: EditField
  274.     selectall: EditField
  275.     ;m
  276.  
  277. :m ClearCell:    \ erase the on-screen contents of the current cell
  278.     CellLeft: self 1 + ( x1)  CellTop: self 1 + ( y1)
  279.     CellRight: self  ( x2)  CellBottom: self ( y2)  put: temprect
  280.     clear: temprect ;m
  281.  
  282. :m ClearBigRectangle:
  283.     gettopx: dataRect get: CellWidth - ( x1)
  284.     gettopy: dataRect get: CellHeight - ( y1)
  285.     getbotx: dataRect  ( x2)  getboty: dataRect ( y2)  put: temprect
  286.     clear: temprect ;m
  287.  
  288. :m AdjustVertical?:  ( -- b)  \ true if vertical scrollbar must change
  289.     get: CurrentRow ( n)  get: VScrollControl ( lo)
  290.         dup get: #ofDisplayRows + 1 - ( hi) within?
  291.         nip        \ nip n left over from within?
  292.     not ;m
  293.  
  294. :m AdjustHorizontal?:  ( -- b)  \ true if horizontal scrollbar must change
  295.     get: CurrentColumn ( n)  get: HScrollControl ( lo)
  296.         dup get: #ofDisplayColumns + 1 - ( hi) within?
  297.         nip        \ nip n left over from within?
  298.     not ;m
  299.  
  300. :m MakeCellVisible:
  301.     AdjustVertical?: self
  302.         IF
  303.             get: CurrentRow  set: VScrollControl
  304.         THEN
  305.     AdjustHorizontal?: self
  306.         IF
  307.             get: CurrentColumn  set: HScrollControl
  308.         THEN
  309.     ClearBigRectangle: self
  310.     draw: self ;m
  311.  
  312. :m MoveTErects:
  313.     CellLeft: self  1 + ( x1) CellTop: self 1 + ( y1)
  314.     CellRight: self ( x2)  CellBottom: self ( y2)  setrects: EditField ;m     \ 28Dec93 XXX
  315.  
  316. :m DoNewCell:
  317.     Visible?: self not IF MakeCellVisible: self THEN
  318.     MoveTErects: self
  319.     ListData->TeText: self
  320.     activate: EditField
  321.     draw: EditField ;m
  322.  
  323. :m DoCellAfterFilterTrap:
  324.     Visible?: self not IF MakeCellVisible: self  MoveTErects: self THEN
  325.     activate: EditField
  326.     0 get: Characters/Cell select: EditField
  327.     draw: EditField ;m
  328.  
  329. \ note, FilterProcedure: should probably be an external action handler or object?
  330. :m FilterProcedure:  ( -- b ) \ true if no problems with cell input data
  331.     true ;m  \ just for now
  332.  
  333. :m DoOldCell:  ( -- b ) \ true if no problems with cell input data
  334.     Visible?: self
  335.         IF deactivate: EditField  ClearCell: self  TeText->Cell: self THEN
  336.     TeText->ListData: self
  337.     FilterProcedure: self ;m
  338.  
  339. :m DoNewCellAfterMouse:
  340.     where: theMouse  ( x y )
  341.     gettopy: dataRect -  get: CellHeight /  get: VScrollControl + put: CurrentRow
  342.     gettopx: dataRect -  get: CellWidth /  get: HScrollControl + put: CurrentColumn
  343.     ;m
  344.  
  345.  
  346.  
  347. \ *** more protocol methods for the scroll controls
  348. \ the scrolls themselves must orchestrate these actions
  349.  
  350. :m prescroll:
  351.     deactivate: EditField ;m
  352.  
  353. :m postscroll:
  354.     MoveTErects: self
  355.     Visible?: self
  356.     IF    activate: EditField
  357.         draw: EditField
  358.     THEN ;m
  359.  
  360. :m click:
  361.     hit?: VScrollControl IF click: VScrollControl exit THEN
  362.     hit?: HScrollControl IF click: HScrollControl exit THEN
  363.     
  364.     where: theMouse
  365.     dataRect PtinRect NIF exit THEN
  366.     
  367.     hit?: EditField
  368.         IF    click: EditField
  369.         ELSE 
  370.             \ must be in datarect, or could not have gotten here
  371.             DoOldCell: self
  372.             IF
  373.                 DoNewCellAfterMouse: self
  374.                 MoveTErects: self
  375.                 ListData->TeText: self
  376.                 activate: EditField
  377.                 draw: EditField
  378.             THEN
  379.         THEN ;m
  380.  
  381. :m idle:
  382.     visible?: self
  383.     IF
  384.         idle: EditField
  385.     THEN ;m
  386.  
  387. :m activate:
  388.     activate: VScrollControl
  389.     activate: HScrollControl
  390.     activate: EditField
  391.     activate: EditField
  392.     ;m
  393.  
  394. :m DoEnter:
  395.     DoOldCell: self
  396.     IF DoNewCell: self THEN ;m
  397.     
  398. :m deactivate:
  399.     \ must inspect any pending text from the user
  400.     \ before allowing a deactivate
  401.     DoEnter: self
  402.     deactivate: VScrollControl
  403.     deactivate: HScrollControl
  404.     deactivate: EditField
  405.     ;m
  406.  
  407. :m DoShift-Tab:
  408.     DoOldCell: self
  409.     IF
  410.         deactivate: EditField
  411.         get: CurrentColumn 1 -  0 max  put: CurrentColumn
  412.         Visible?: self not IF -1 DoCtl: HScrollControl THEN
  413.         DoNewCell: self
  414.     THEN ;m
  415.  
  416. :m DoTab:
  417.     ShiftKey?: fevent
  418.     IF
  419.         DoShift-Tab: self
  420.     ELSE
  421.         DoOldCell: self
  422.         IF
  423.             deactivate: EditField
  424.             get: CurrentColumn 1 +  get: #ofColumns 1 - min  put: CurrentColumn
  425.             Visible?: self not IF 1 DoCtl: HScrollControl THEN
  426.             DoNewCell: self
  427.         THEN
  428.     THEN ;m
  429.  
  430. :m DoShift-Return:
  431.     DoOldCell: self
  432.     IF
  433.         deactivate: EditField
  434.         get: CurrentRow 1 -  0 max  put: CurrentRow
  435.         Visible?: self not IF -1 DoCtl: VScrollControl THEN
  436.         DoNewCell: self
  437.     THEN ;m
  438.  
  439. :m DoReturn:
  440.     ShiftKey?: fevent
  441.     IF
  442.         DoShift-Return: self
  443.     ELSE
  444.         DoOldCell: self
  445.         IF
  446.             deactivate: EditField
  447.             get: CurrentRow 1 +  get: #ofRows 1 - min  put: CurrentRow
  448.             Visible?: self not IF 1 DoCtl: VScrollControl THEN
  449.             DoNewCell: self
  450.         THEN
  451.     THEN ;m
  452.  
  453. :m AssureTEvisible:
  454.     Visible?: self not
  455.         IF
  456.             deactivate: EditField
  457.             MakeCellVisible: self
  458.             MoveTERects: self
  459.             activate: EditField
  460.             draw: EditField
  461.         THEN ;m
  462.  
  463. :m key:  ( char -- )
  464.     CASE
  465.         3    OF    DoEnter: self            ENDOF
  466.         9    OF    DoTab: self                ENDOF
  467.         13    OF    DoReturn: self            ENDOF
  468.         28    OF    DoShift-Tab: self        ENDOF    \ left-arrow
  469.         29    OF    DoTab: self                ENDOF    \ right-arrow
  470.         30    OF    DoShift-Return: self    ENDOF    \ up-arrow
  471.         31    OF    DoReturn: self            ENDOF    \ down-arrow
  472.     ( all other keys)
  473.     AssureTEvisible: self
  474.         key: EditField
  475.     0  ( 0 is dropped by endcase)
  476.     ENDCASE
  477.     EditField call ValidRect
  478.     ;m
  479.  
  480. :m cut:
  481.     AssureTEvisible: self
  482.     cut: EditField ;m
  483.  
  484. :m copy:
  485.     AssureTEvisible: self
  486.     copy: EditField ;m
  487.  
  488. :m paste:
  489.     AssureTEvisible: self
  490.     paste: EditField ;m
  491.  
  492. :m clear:
  493.     AssureTEvisible: self
  494.     clear: EditField ;m
  495.  
  496. ;class
  497.  
  498. endload
  499.  
  500. *** EXAMPLE USE
  501.  
  502. selwindow w
  503. test: w 
  504.  
  505. editlist e
  506. e add: w
  507.